NFL
Dylan Nikol
11/19/2020
#load packages
library(devtools)## Loading required package: usethislibrary(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(gganimate)## Loading required package: ggplot2library(ggforce)
library(ggplot2)
library(readr)
# load helper functions
#install.packages("patchwork")
source_url("https://raw.githubusercontent.com/asonty/ngs_highlights/master/utils/scripts/data_utils.R")## SHA-1 hash of file is 41d9b285cdbab225cfc5a46dbd15ae742b591dc2source_url("https://raw.githubusercontent.com/asonty/ngs_highlights/master/utils/scripts/plot_utils.R")## SHA-1 hash of file is 24e218e6f49b700d341aa13846fcc31d42058193MIA_plays <- read_csv("nfl-big-data-bowl-2021/team_plays/MIA_plays.csv",
col_types = cols(X1 = col_skip()))## Warning: Missing column names filled in: 'X1' [1]## Warning: 77184 parsing failures.
## row col expected actual file
## 6643 penaltyCodes 1/0/T/F/TRUE/FALSE UNRd 'nfl-big-data-bowl-2021/team_plays/MIA_plays.csv'
## 6643 penaltyJerseyNumbers 1/0/T/F/TRUE/FALSE TEN 21 'nfl-big-data-bowl-2021/team_plays/MIA_plays.csv'
## 6644 penaltyCodes 1/0/T/F/TRUE/FALSE UNRd 'nfl-big-data-bowl-2021/team_plays/MIA_plays.csv'
## 6644 penaltyJerseyNumbers 1/0/T/F/TRUE/FALSE TEN 21 'nfl-big-data-bowl-2021/team_plays/MIA_plays.csv'
## 6645 penaltyCodes 1/0/T/F/TRUE/FALSE UNRd 'nfl-big-data-bowl-2021/team_plays/MIA_plays.csv'
## .... .................... .................. ...... .................................................
## See problems(...) for more details.head(MIA_plays)## # A tibble: 6 x 52
## time x y s a dis o dir event nflId
## <dttm> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <chr> <dbl>
## 1 2018-09-09 17:13:44 77.8 33.4 0.97 1.13 0.09 131. 278. None 2.35e3
## 2 2018-09-09 17:13:44 84.5 17.1 0 0 0 295. 241. None 2.65e3
## 3 2018-09-09 17:13:44 82.3 18.3 0.11 0.38 0.01 60.4 54.1 None 7.14e4
## 4 2018-09-09 17:13:44 84.7 36.6 0 0 0 276. 142. None 2.51e6
## 5 2018-09-09 17:13:44 88.0 23.7 0.01 0.01 0 269. 305. None 2.53e6
## 6 2018-09-09 17:13:44 68.2 23.2 0.36 1.02 0.03 107. 191. None 2.54e6
## # … with 42 more variables: displayName <chr>, jerseyNumber <dbl>,
## # position <chr>, frameId <dbl>, team <chr>, gameId <dbl>, playId <dbl>,
## # playDirection <chr>, route <chr>, gameDate <chr>, gameTimeEastern <time>,
## # homeTeamAbbr <chr>, visitorTeamAbbr <chr>, week <dbl>,
## # playDescription <chr>, quarter <dbl>, down <dbl>, yardsToGo <dbl>,
## # possessionTeam <chr>, playType <chr>, yardlineSide <chr>,
## # yardlineNumber <dbl>, offenseFormation <chr>, personnelO <chr>,
## # defendersInTheBox <dbl>, numberOfPassRushers <dbl>, personnelD <chr>,
## # typeDropback <chr>, preSnapVisitorScore <dbl>, preSnapHomeScore <dbl>,
## # gameClock <time>, absoluteYardlineNumber <dbl>, penaltyCodes <lgl>,
## # penaltyJerseyNumbers <lgl>, passResult <chr>, offensePlayResult <dbl>,
## # playResult <dbl>, epa <dbl>, isDefensivePI <lgl>, homeTeamFlag <dbl>,
## # teamAbbr <chr>, positionGroup <chr>R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
# rename column
names(MIA_plays)[names(MIA_plays) == "frameId"] <- "frame"
colnames(MIA_plays)## [1] "time" "x" "y"
## [4] "s" "a" "dis"
## [7] "o" "dir" "event"
## [10] "nflId" "displayName" "jerseyNumber"
## [13] "position" "frame" "team"
## [16] "gameId" "playId" "playDirection"
## [19] "route" "gameDate" "gameTimeEastern"
## [22] "homeTeamAbbr" "visitorTeamAbbr" "week"
## [25] "playDescription" "quarter" "down"
## [28] "yardsToGo" "possessionTeam" "playType"
## [31] "yardlineSide" "yardlineNumber" "offenseFormation"
## [34] "personnelO" "defendersInTheBox" "numberOfPassRushers"
## [37] "personnelD" "typeDropback" "preSnapVisitorScore"
## [40] "preSnapHomeScore" "gameClock" "absoluteYardlineNumber"
## [43] "penaltyCodes" "penaltyJerseyNumbers" "passResult"
## [46] "offensePlayResult" "playResult" "epa"
## [49] "isDefensivePI" "homeTeamFlag" "teamAbbr"
## [52] "positionGroup"Including Plots
You can also embed plots, for example:
## [1] 11## [1] 179### pick a play to visualize
play_data <- filter(MIA_plays, playId == "4172") #BAL 4347 (a lot of laterals)
first_frame <- play_data %>%
filter(event == "ball_snap") %>%
distinct(frame) %>%
slice_max(frame) %>%
pull()
final_frame <- play_data %>%
filter(event == "tackle" | event == "touchdown" | event == "out_of_bounds") %>%
distinct(frame) %>%
slice_max(frame) %>%
pull()
first_frame## [1] 11final_frame## [1] 179# plot play frame plot
plot_play_frame(play_data_ = play_data, frame_ = 11)
# plot play frame plot with velocity vectors
plot_play_frame(play_data_ = play_data, frame_ = 50, velocities_ = T)
# plot play frame plot with Voronoi Tessellation
#install.packages("deldir")
library(deldir)## deldir 0.2-3 Nickname: "Stack Smashing Detected"##
## Note 1: As of version 0.2-1, error handling in this
## package was amended to conform to the usual R protocol.
## The deldir() function now actually throws an error
## when one occurs, rather than displaying an error number
## and returning a NULL.
##
## Note 2: As of version 0.1-29 the arguments "col"
## and "lty" of plot.deldir() had their names changed to
## "cmpnt_col" and "cmpnt_lty" respectively basically
## to allow "col" and and "lty" to be passed as "..."
## arguments.
##
## Note 3: As of version 0.1-29 the "plotit" argument
## of deldir() was changed to (simply) "plot".
##
## See the help for deldir() and plot.deldir().plot_play_frame(play_data_ = play_data, frame_ = 50, velocities_ = F, voronoi_ = T)
# plot n play frames Voronoi Tessellation (mess around with first frame to get to work)
plot_play_sequence(play_data, first_frame_ = first_frame, final_frame_ = final_frame, n_ = 3, velocities_ = T, voronoi_ = T)
### Animating plays
# reduce dataset
reduced_play_data <- play_data %>% filter(frame >= first_frame, frame <= final_frame+10)
# get play details
play_desc <- reduced_play_data$playDescription %>% .[1]
play_dir <- reduced_play_data$playDirection %>% .[1]
yards_togo <- reduced_play_data$yardsToGo %>% .[1]
los <- reduced_play_data$absoluteYardlineNumber %>% .[1]
togo_line <- if(play_dir=="left") los-yards_togo else los+yards_togo
# separate player and ball tracking data
player_data <- reduced_play_data %>%
select(frame, homeTeamFlag, teamAbbr, displayName, nflId, jerseyNumber, position, positionGroup,
x, y, s, o, dir, event) %>%
filter(displayName != "Football")
ball_data <- reduced_play_data %>%
select(frame, homeTeamFlag, teamAbbr, displayName, jerseyNumber, position, positionGroup,
x, y, s, o, dir, event) %>%
filter(displayName == "Football")
# get team details
h_team <- reduced_play_data %>% filter(homeTeamFlag == 1) %>% distinct(teamAbbr) %>% pull()
a_team <- reduced_play_data %>% filter(homeTeamFlag == 0) %>% distinct(teamAbbr) %>% pull()
# call helper function to get team colors
team_colors <- fetch_team_colors(h_team_ = h_team, a_team_ = a_team)
h_team_color1 <- team_colors[1]
h_team_color2 <- team_colors[2]
a_team_color1 <- team_colors[3]
a_team_color2 <- team_colors[4]
# compute velocity components
# velocity angle in radians
player_data$dir_rad <- player_data$dir * pi / 180
# velocity components
player_data$v_x <- sin(player_data$dir_rad) * player_data$s
player_data$v_y <- cos(player_data$dir_rad) * player_data$s
# identify the fastest player from each team at each frame
fastest_players <- player_data %>% # filter out ball-tracking data
group_by(frame, teamAbbr) %>% # group by frame and team
arrange(s) %>% top_n(s, n=1) %>% # take only the players with the highest speed on each team at every frame
mutate(isFastestFlag = 1) %>% # create new flag identifying fastest players
ungroup() %>%
select(frame, nflId, isFastestFlag) %>% # reduce dataset to the columns needed for joining and the new flag
arrange(frame) # sort by frame
player_data <- player_data %>%
left_join(fastest_players, by = c("frame" = "frame", "nflId" = "nflId")) %>% # join on frame and nf;Id
mutate(isFastestFlag = case_when(is.na(isFastestFlag) ~ 0, TRUE ~ 1)) # replace NA values for isFastestFlag with 0
# this does the same thing
#player_data <- left_join(player_data,fastest_players, by = c("frame" = "frame", "nflId" = "nflId"))
#player_data$isFastestFlag[is.na(player_data$isFastestFlag)] = 0
play_frames <- plot_field() + # plot_field() is a helper function that returns a ggplot2 object of an NFL field
# line of scrimmage
annotate(
"segment",
x = los, xend = los, y = 0, yend = 160/3,
colour = "#0d41e1"
) +
# 1st down marker
annotate(
"segment",
x = togo_line, xend = togo_line, y = 0, yend = 160/3,
colour = "#f9c80e"
) +
# away team velocities
geom_segment(
data = player_data %>% filter(teamAbbr == a_team),
mapping = aes(x = x, y = y, xend = x + v_x, yend = y + v_y),
colour = a_team_color1, size = 1, arrow = arrow(length = unit(0.01, "npc"))
) +
# home team velocities
geom_segment(
data = player_data %>% filter(teamAbbr == h_team),
mapping = aes(x = x, y = y, xend = x + v_x, yend = y + v_y),
colour = h_team_color1, size = 1, arrow = arrow(length = unit(0.01, "npc"))
) +
# away team locations
geom_point(
data = player_data %>% filter(teamAbbr == a_team),
mapping = aes(x = x, y = y),
fill = "#ffffff", color = a_team_color2,
shape = 21, alpha = 1, size = 6
) +
# away team jersey numbers
geom_text(
data = player_data %>% filter(teamAbbr == a_team),
mapping = aes(x = x, y = y, label = jerseyNumber),
color = a_team_color1, size = 3.5, #family = "mono"
) +
# home team locations
geom_point(
data = player_data %>% filter(teamAbbr == h_team),
mapping = aes(x = x, y = y),
fill = h_team_color1, color = h_team_color2,
shape = 21, alpha = 1, size = 6
) +
# home team jersey numbers
geom_text(
data = player_data %>% filter(teamAbbr == h_team),
mapping = aes(x = x, y = y, label = jerseyNumber),
color = h_team_color2, size = 3.5, #family = "mono"
) +
# ball location
geom_point(
data = ball_data,
mapping = aes(x = x, y = y),
fill = "#935e38", color = "#d9d9d9",
shape = 21, alpha = 1, size = 4
) +
# highlight fastest players
geom_point(
data = player_data %>% filter(isFastestFlag == 1),
mapping = aes(x = x, y = y),
colour = "#e9ff70",
alpha = 0.5, size = 8
) +
# play description and always cite your data source!
labs(
title = play_desc, #strwrap(play_desc,100)
caption = "Source: NFL Next Gen Stats"
) +
# animation stuff
transition_time(frame) +
ease_aes('linear') +
NULL
# ensure timing of play matches 10 frames-per-second (h/t NFL Football Ops)
play_length <- length(unique(player_data$frame))
play_anim <- animate(
play_frames,
fps = 10,
nframe = play_length,
width = 850,
height = 500,
end_pause = 10
)
play_anim
## [1] "(:07) (Shotgun) R.Tannehill pass short right to K.Stills to MIA 45 for 14 yards. Lateral to D.Parker to MIA 48 for 3 yards. Lateral to K.Drake for 52 yards, TOUCHDOWN. The Replay Official reviewed the score ruling, and the play was Upheld. The ruling on the field was confirmed."